home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / dev / cross / GBDK-2.0.lha / GBDK / lib / fp_long.s < prev    next >
Text File  |  1998-11-14  |  34KB  |  1,891 lines
  1.     .include "global.s"
  2.  
  3. ;    This is a set of routines for floating point handling for C
  4.  
  5. ;    The format of a floating point number is as follows:
  6. ;
  7. ;            ------------
  8. ;            *   sign   *    1 bit
  9. ;            *----------*
  10. ;            * exponent *    7 bits
  11. ;            *----------*
  12. ;            * mantissa *    24 bits, normalized
  13. ;            ------------
  14. ;
  15. ;        Note that the number is stored with the mantissa in the
  16. ;        low order bytes, i.e. the sign is the most significant
  17. ;        bit of the most significant byte.
  18.  
  19.     .area   _BSS
  20.  
  21.     ; Temporary registers
  22. .ldivloopcount:
  23. .scratch:    .ds    1
  24.     ; Working float
  25. .res:    
  26.         .ds    4
  27. .mul:
  28.         .ds    4
  29.  
  30. .mulloops:
  31. .fdiv32loops:
  32. .faddscratch:    .ds    1
  33. .fmulcount:    .ds     1
  34. .fw:        .ds    4
  35. .q:
  36. .ft:
  37.         .ds    4
  38. fperr:        .ds    1    ; floating over/underflow flag
  39.  
  40.     .area _CODE
  41.  
  42.  
  43. ;    Set the floating overflow flag and return zero. Floating execptions
  44. ;    may be caught in which case the appropriate routine will be called.
  45.  
  46. fpovrflw:
  47.     ld    a,#1
  48.     ld    (fperr),a
  49. fpzero:
  50.     ld    hl,#0        ; Make HLDE = 0
  51.     ld    e,l
  52.     ld    d,h
  53.     ret
  54.  
  55. ;    Negate the mantissa in LDE.
  56. negmant::
  57.     xor    a        ; Zero a, reset carry
  58.     sub    e
  59.     ld    e,a
  60.     ld    a,#0
  61.     sbc    d
  62.     ld    d,a
  63.     
  64.     ld    a,#0
  65.     sbc    l        ;negate the hi byte
  66.     ld    l,a        ;put back
  67.     ret            ;and return
  68.  
  69. ;     Change it to adding HLDE with BCfl1fl0
  70. ;    Make HLDE equal ft
  71. fladd_getother:        ; Just return fl3fl2fl1fl0 in HLDE
  72.     ld    a,(.fw+3)
  73.     ld    h,a
  74.     ld    a,(.fw+2)
  75.     ld    l,a
  76.     ld    a,(.fw+1)
  77.     ld    d,a
  78.     ld    a,(.fw+0)
  79.     ld    e,a
  80.     ret
  81.  
  82. ;    Swap the two floating pt registers HLDE and ft3ft2ft1ft0
  83. ;    Destroys BC
  84. fladd_swap::
  85.     push    af
  86.     push    hl
  87.     push    de
  88.     ld    hl,#.fw
  89.     ld    a,(hl+)
  90.     ld    e,a
  91.     ld    a,(hl+)
  92.     ld    d,a
  93.     ld    a,(hl+)
  94.     ld    h,(hl)
  95.     ld    l,a
  96.     pop    bc
  97.     ld    a,c
  98.     ld    (.fw+0),a
  99.     ld    a,b
  100.     ld    (.fw+1),a
  101.     pop    bc
  102.     ld    a,c
  103.     ld    (.fw+2),a
  104.     ld    a,b
  105.     ld    (.fw+3),a
  106.     pop    af
  107.     ret
  108.     
  109.  
  110. ;    Floating subtraction. The value on the stack is subtracted from the
  111. ;    value in HLDE. To simplify matters, we do it thus:
  112. ;
  113. ;    A-B == A+-B
  114. .fsub32::
  115. flsub:
  116.     push    hl
  117.     lda    hl,7(sp)    ; HL points to exponent on stack
  118.     ld    a,(hl)
  119.     xor    #0x80        ; Toggle the sign bit
  120.     ld    (hl),a
  121.     pop    hl
  122.  
  123.     ;fall through to fladd
  124.  
  125.  
  126. ;    Floating addition:
  127. ;        Add the value in HLDE to the value on the stack, and
  128. ;        return with the argument removed from the stack.
  129.  
  130. ;    Timings for adding 1976.0 and 10.0
  131. ;        Initial version                - 4080
  132. ;        Removed .exxs, replaced with fadd_swap    - 2500
  133. ;        Removed swaps around actual add        - 1860
  134. ;        Optimised fpnorm            - 1620
  135. ;        Improved setup                - 1184
  136. ;        Improved neg mant detect code        - 952
  137. ;        Found bug in fpnorm            - 1060
  138. ;         Note that the speed depends on the order
  139. ;         that the operands are in
  140. ;         If HLDE is > stack, then the routine is faster
  141. ;        Optimised so that fpnorm and round arnt - 816
  142. ;         used unless the number overflows into
  143. ;         H         
  144.  
  145. ;     Analysis of routine
  146. ;    fladd:
  147. ;        Recover right operand
  148. ;        If either operand is zero, return the other
  149. ;        Make the smaller number current
  150. ;        Comupte the number of bits difference (BD)
  151. ;        If BD > 24, return the larger
  152. ;        Adjust smaller until both have the same exponent
  153. ;        Save the exponent of either (=exponent of result) (E)
  154. ;        Fiddle with mag+sign on both
  155. ;            Make H=0x0ff if num is negative
  156. ;            Else H=0
  157. ;        Add
  158. ;        Rotate right once, saving LSB
  159. ;        Increase exponent to make up for RR'ing number
  160. ;        Restore sign and new exponent
  161. ;        Negate mantissa if new is negative
  162. ;        Round if LSB was one
  163. ;        Normalise
  164.  
  165. .fadd32::
  166. fladd:
  167.     ld    a,l        ;check 1st operand for zero
  168.     or    d
  169.     or    e        ;only need to check mantissa
  170.     jr    nz,5$        ; Mantissa is not zero
  171.     pop    bc        ; mantissa is zero - return other operand
  172.     pop    de
  173.     pop    hl
  174.     push    bc
  175.     ret
  176. 5$:
  177.     ld    a,e        ; Store the current operand
  178.     ld    (.fw+0),a
  179.     ld    a,d
  180.     ld    (.fw+1),a
  181.     ld    a,l
  182.     ld    (.fw+2),a
  183.     ld    a,h
  184.     ld    (.fw+3),a
  185.     
  186.     pop    bc        ; return address
  187.     pop    de        ; low word of 2nd operand
  188.     pop    hl        ; hi word
  189.     push    bc        ; put return address back on stack
  190.     ld    a,l        ; check for zero 2nd arg
  191.     or    d
  192.     or    e        ;if zero, just return the 1st operand
  193.     jr    nz,6$        ; Not zero - so continue
  194.     jp    fladd_getother    ; Zero - return other operand
  195. 6$:
  196.     ld    a,(.fw+3)
  197.     res    7,a        ;clear sign
  198.     ld    c,h        ;get exponent
  199.     res    7,c        ;and clear sign
  200. a::
  201.     sub    c        ;find difference
  202.     jr    nc,1$        ;if negative,
  203.     call    fladd_swap    ; switch operands
  204.     ld    c,a        ; Make the difference positive
  205.     xor    a        ; (A = 0)
  206.     sub    c
  207.  
  208. 1$:
  209.     cp    #24        ; if less than 24 bits difference,
  210.     jr    c,2$        ; we can do the add
  211.     jp    fladd_getother    ; otherwise just return the larger value
  212. 2$:
  213.     or    a        ; check for zero difference
  214.     call    nz,fpadjust    ; adjust till equal
  215.     ld    a,h        ; save exponent of result
  216.     ld    (.faddscratch),a
  217.     bit    7,h        ; test sign, do we need to negate?
  218.     ld    h,#0        ; zero fill in case +ve
  219.     jr    z,3$        ; no
  220.     call    negmant        ; yes
  221.     ld    h,#0x0ff    ; 1 fill top byte
  222. 3$:
  223.     ld    a,(.fw+3)
  224.     bit    7,a        ;test sign, do we need to negate?
  225.     ld    a,#0        ;zero fill in case +ve
  226.     ld    (.fw+3),a
  227.     jr    z,4$        ;no
  228.     call    fladd_swap
  229.     call    negmant        ;yes
  230.     ld    h,#0x0ff    ;1 fill top byte
  231. 4$:
  232.     ld    c,l
  233.     ld    b,h
  234.     ld    hl,#.fw
  235.     ld    a,(hl+)
  236.     add    e
  237.     ld    e,a
  238.     ld    a,(hl+)
  239.     adc    d
  240.     ld    d,a
  241.     ld    a,(hl+)
  242.     adc    c
  243.     ld    c,a
  244.     ld    a,(hl)
  245.     adc    b
  246.     ld    h,a
  247.     ld    l,c
  248.  
  249.     sra    h        ; now shift down 1 bit to compensate
  250.     rr    l        ; Rotate in the carry bit
  251.     rr    d        ; propogate the shift
  252.     rr    e
  253.  
  254.     push    af              ;save carry flag
  255.     ld    a,(.faddscratch)
  256.         res     7,a             ;clear sign from exponent
  257.         inc     a               ;increment to compensate for shift above
  258.         ld      c,a             ;save it
  259.         ld      a,h
  260.         and     #0x80           ;mask off low bits
  261.         or      c               ;or in exponent
  262.         ld      h,a             ;now have it!
  263.     bit    7,h
  264.     call    nz,negmant
  265.         pop     af              ;restore carry flag
  266.         call    c,round         ;round up if necessary
  267.                         ;normalize and return!!
  268.  
  269. ;    fpnorm    - passed a floating point number in HLDE (sign and exponent
  270. ;        in H) - returns with it normalized.
  271. ;
  272. ;    Points to note:
  273. ;        Normalization consists of shifting the mantissa until there
  274. ;        is a 1 bit in the MSB of the mantissa.
  275. ;
  276. fpnorm::
  277.     bit    7,l        ; If it's already normalised, then do nothing
  278.     ret    nz
  279.  
  280.     ld    a,l        ;check for zero mantissa
  281.     or    d
  282.     or    e
  283.     jp    z,fpzero    ;make it a clean zero
  284.  
  285.     ld    b,h        ; Store the exponent in B
  286.     ld    c,b        ;copy into c
  287.     res    7,c        ;reset the sign bit
  288.  
  289.     ; We know that bit 7 is zero due to test above
  290. 5$:
  291.     dec    c        ;decrement exponent
  292.     bit     7,c
  293.     jp    nz,fpovrflw    ; Exp is <0 - underflow
  294.  
  295.     or    a        ; Clear carry
  296.     rl    e        ; Rotate LDE left
  297.     rl    d
  298.     rl    l
  299.  
  300.     bit    7,l        ; Is HLDE normalised?
  301.     jr    z,5$        ; no - loop
  302.  
  303. 3$:
  304.     bit    7,b        ;test sign
  305.     jr    z,4$        ;skip if clear
  306.     set    7,c        ;set the new sign bit
  307. 4$:
  308.     ld    h,c        ;put exponent and sign back where it belongs
  309.     ret            ;finished
  310.  
  311. ;    Round the number in HLDE up by one, because of a shift of bits out
  312. ;    earlier
  313.  
  314. round:
  315.     inc    e
  316.     ret    nz
  317.     inc    d
  318.     ret    nz
  319.     inc    l
  320.     ret    nz
  321. ;    
  322. ;    ld    a,#1        ; Add 1 to LDE
  323. ;    add    e
  324. ;    ld    e,a
  325. ;    ld    a,#0
  326. ;    adc    d
  327. ;    ld    d,a
  328. ;
  329. ;    ld    a,#0
  330. ;    adc    l    
  331. ;    ld    l,a
  332.  
  333. ;    jr    nc,2$        ; Carry is clear - dont need to increase
  334.                 ; exponent
  335.     ; Shift the carry in
  336.     ; ALT: LDE will equal 800000 - speedup?
  337.     rr    l        ; Carry is set - rr mantissa and increase
  338.     rr    d        ; exponent
  339.     rr    e
  340.     ld    a,h        ; get exponent/sign
  341.     and    #0x07f        ; get exponent only
  342.     inc    a        ; add one
  343.     ld    c,a
  344.     ld    a,h
  345.     and    #0x080
  346.     or    c        ;now exponent and sign again
  347.     ld    h,a
  348. 2$:
  349.     ret
  350.  
  351. ;    Adjust the floating number in HLDE by increasing the exponent by the
  352. ;    contents of A. The mantissa must be shifted right to compensate.
  353.  
  354. fpadjust:
  355.     and    #0x01F        ;mask of hi bits - irrelevant
  356. 1$:
  357.     srl    l        ; Rotate mantissa right
  358.     rr    d
  359.     rr    e
  360.     inc    h        ; increment exponent - it will not overflow
  361.     dec    a
  362.     jr     nz,1$        ; loop if more
  363.     ret
  364.  
  365. ;    Get the right operand into HLDE', leave the left operand
  366. ;    where it is in HLDE, but make both of them +ve. The original
  367. ;    exponents/signs are left in C and B, left and right operands
  368. ;    respectively.
  369.  
  370. fsetup::
  371.     push    hl
  372.     lda    hl,6(sp)
  373.     ld    a,(hl+)
  374.     ld    (.fw+0),a    ; lower word of right operand
  375.     ld    a,(hl+)
  376.     ld    (.fw+1),a
  377.     ld    a,(hl+)        ; high word of right operand
  378.     ld    (.fw+2),a
  379.     ld    a,(hl)
  380.     ld    (.fw+3),a
  381.     
  382.     pop    hl
  383.     ld    a,h        ; Store HL
  384.     ld    (.scratch),a
  385.     ld    a,l
  386.  
  387.     pop    hl
  388.     pop    bc
  389.     lda    sp,4(sp)    ; Unjunk stack
  390.     push    bc
  391.     push    hl
  392.  
  393.     ld    l,a        ; Recover HL
  394.     ld    a,(.scratch)
  395.     ld    h,a
  396.     ld    c,a        ; Store the exponent
  397.     res    7,h        ; Make the working copy positive
  398.     ld    a,(.fw+3)
  399.     ld    b,a
  400.     res    7,a
  401.     ld    (.fw+3),a
  402.     ret
  403.  
  404. ;    Floating multiplication. The number in HLDE is multiplied by the
  405. ;    number on the stack under the return address. The stack is cleaned
  406. ;    up and the result returned in HLDE.
  407. ;
  408. ;    Timings: multiply 1976.0 by 10.0
  409. ;        Initial                    - ~60000
  410. ;        Much hacking afterwards            - 6268
  411. ;        Added mulx0 = 8 shift hack        - 5228
  412. ;        Trimmed some old instruction        - 5148
  413. ;        Improved fsetup                - 4436
  414.  
  415. .fmul32::
  416. flmul:
  417.     call    fsetup        ;get operands, make them +ve.
  418.  
  419.     push    bc        ;save exponents etc.
  420.  
  421.     ld    a,d        ; Set DEDE' equal to HLDE
  422.     ld    (.ft+1),a
  423.     ld    a,e
  424.     ld    (.ft+0),a
  425.     ld    e,l        ; D is zeroed later
  426.  
  427.     xor    a        ; Zero product
  428.     ld    (.fw+3),a    
  429.     ld    h,a
  430.     ld    l,a
  431.     ld    b,a
  432.     ld    c,a
  433.     ld    d,a        
  434.  
  435.     ld    a,(.fw+0)    ; get low 8 bits of multiplier
  436.     call    mult26        ; do 8 bits of multiply
  437.  
  438.     ld    a,(.fw+1)
  439.     call    mult8        ;next 8 bits
  440.  
  441.     ld    a,(.fw+2)    ;next 8 bits
  442.     call    mult8        ;do next chunk
  443.  
  444.     ld    d,b
  445.     ld    e,c
  446.     ld    a,h        ;get hi byte
  447.     ld    h,#0
  448.     ld    c,h        ;zero lower byte
  449.     jr    1$        ;skip forward     1f
  450. 2$:    ; 2
  451.     srl    a
  452.     rr    l
  453.     rr    d
  454.     rr    e
  455.     rr    c        ;save carry bit in c
  456.     inc    h
  457. 1$:    ; 1
  458.     or    a        ;hi byte zero yet?
  459.     jr    nz,2$        ;no, keep shifting down        2b
  460.     ld    a,c        ;copy shifted-out bits
  461.     ld    (.scratch),a
  462.     pop    bc        ;get exponents
  463.     bit    7,l        ;check for zero mantissa
  464.     jp    z,fpzero    ;return a clean zero if so
  465.     ld    a,c
  466.     res    7,a        ;mask off sign
  467.     sub    #0x41        ;remove bias, allow one bit shift
  468.     add    a,h        ;add in shift count
  469.     sub    #6        ;compensate for shift up earlier
  470.     ld    h,b        ;the other
  471.     res    7,h        ;mask off signs
  472.     add    a,h        ;add them together
  473.     ld    h,a        ;put exponent in
  474.     ld    a,c        ;now check signs
  475.     xor    b
  476.  
  477.     bit    7,a
  478.     ret    z        ;return if +ve
  479.  
  480.     set    7,h        ;set sign flag
  481.     ld    a,(.scratch)
  482.     rla            ;shift top bit out
  483.     ret    nc        ;return if no carry
  484.     jp    round        ;round it
  485.  
  486. ;     Register useage
  487. ;        HL  1
  488. ;        HL' 1
  489. ;        DE  11
  490. ;        DE' 11
  491.  
  492.  
  493. mult26::
  494.     push    af
  495.     ld    a,#6
  496.     ld    (.fmulcount),a
  497. 3$:    ; 3
  498.     pop    af
  499.     srl    a        ;shift LSB of multiplier into carry
  500.     jr    nc,1$        ; 1f
  501.     push    af
  502.     
  503.     ld    a,(.ft+0)
  504.     add    c
  505.     ld    c,a
  506.     ld    a,(.ft+1)
  507.     adc    b
  508.     ld    b,a
  509.  
  510.     jr    nc,2$
  511.     inc    hl
  512. 2$:
  513.     add    hl,de
  514.     pop    af
  515. 1$:    ; 1
  516.     push    af
  517.     or    a
  518.     push    hl
  519.     ld    hl,#.ft
  520.     rl    (hl)
  521.     inc    hl
  522.     rl    (hl)
  523.     pop    hl
  524.     rl    e
  525.     rl    d
  526.  
  527.     ld    a,(.fmulcount)
  528.     dec    a
  529.     ld    (.fmulcount),a
  530.  
  531.     jr     nz,3$
  532.  
  533.     ld    a,#2
  534.     ld    (.fmulcount),a
  535.     pop    af
  536.     jr    mul8_4        ; 4f
  537.  
  538. ; Register useage count
  539. ;        HL  11
  540. ;        HL' 11
  541. ;        DE  1
  542. ;        DE' 1
  543.  
  544. mult8::
  545.                 ; Encapsulate it
  546.     cp    #0        ; Simple hack to speed up mul if A = 0
  547.     jr    nz,mul8_normal
  548.                 ; If A = 0, then it's just rr HLBC 8 times
  549.     ld    c,b
  550.     ld    b,l
  551.     ld    h,a        ; (A=0)        
  552.     ret
  553.  
  554. mul8_normal:
  555.     push    af
  556.     ld    a,#8
  557.     ld    (.fmulcount),a
  558. mul8_3:
  559.     pop    af
  560.     srl    h
  561.     rr    l
  562.     rr    b
  563.     rr    c    
  564. mul8_4: ; 4
  565.     srl    a        ;shift LSB into carry
  566.     jr    nc,1$        ; 1f
  567.     push    af
  568.     ld    a,(.ft+0)
  569.     add    c
  570.     ld    c,a
  571.     ld    a,(.ft+1)
  572.     adc    b
  573.     ld    b,a
  574.  
  575.     jr    nc,2$
  576.     inc    hl
  577. 2$:
  578.     add    hl,de
  579.     pop    af
  580. 1$:
  581.     push    af
  582.     ld    a,(.fmulcount)
  583.     dec    a
  584.     ld    (.fmulcount),a
  585.     jr    nz,mul8_3        ;more?    3b
  586.     
  587.                 ; De-encapsulate
  588.     pop    af
  589.     ret            ;no, return as is
  590.  
  591.  
  592. ;    Floating division. The number in HLDE is divided by the
  593. ;    number on the stack under the return address. The stack is cleaned
  594. ;    up and the result returned in HLDE.
  595. ;
  596. ;    Timings Divide 1976.0 by 10.0 giving 197.600006-ish
  597. ;        Initial                    - 111272
  598. ;        Removed .exx's around 3$        - 72512
  599. ;        Removed all .exx's up to 5$        - 20192
  600. ;        Swapped BCBC' for q4..q0        - 19708
  601. ;        Swapped HL' for BC            - 14428
  602. ;        Removed .exafaf's            - 14120
  603. ;        Found a redundant scf            - 14060
  604. ;        Found that D was free - removed q1    - 13060
  605. ;        Better shift of q            - 9856
  606. ;    Profile counts
  607. ;        Useage of    HL  11(.5)1
  608. ;                HL' 11(.5)1
  609. ;                DE  1
  610. ;                DE' 1
  611. ;        Useage of    q3  11
  612. ;                q1  11
  613.  
  614. .fdiv32::
  615. fldiv:
  616.     call    fsetup        ; get operands, make them +ve.
  617.                 ; NOTE returns with them in HLDE, HLDE' =12 34
  618.                 ; and orig exponents in BC = 5
  619.                 ; fsetup takes 1044 cycles
  620.                 ; Time from here
  621.     push    bc        ; save exponents etc.    TOS=5
  622.                 ; Swap DE and HL'
  623.     ld    b,d        ; HL=1,DE=2,HL'=3,DE'=4
  624.                 ; Then HL=1,HL'=2,DE=3,DE'=4
  625.     ld    c,e        ; Ignore D as it's zeroed later
  626.     ld    a,(.fw+2)
  627.     ld    e,a
  628.  
  629.     xor    a        ; Zero a
  630.     ld    (.q+0),a    ; ...and the quotient
  631.     ld    d,a        ; D is free
  632.     ld    (.q+2),a
  633.     ld    (.q+3),a
  634.  
  635.     ld    h,a        ; Zero top byte of divisor
  636.                 ; Dividend is taken care of later
  637.     
  638.                 ; Ends with HL=1,HL'=2,DE=3,DE'=4
  639.     ld    a,#24+6        ;number of bits in dividend and then some
  640.     ld    (.fdiv32loops),a
  641.  
  642. 3$:
  643.     ld    a,h
  644.     cp    d
  645.     jr    c,5$
  646.     jr    nz,8$
  647.     ld    a,l
  648.     cp    e
  649.     jr    c,5$
  650. 8$:
  651.     push    bc
  652.     push    hl        ;save dividend - hl is now free
  653.  
  654.     ld    hl,#.fw
  655.                 ; Subtract DEfw1fw0 from HLBC
  656.     ld    a,c        ; Subtract fw1fw0 from BC
  657.     sub    (hl)
  658.     ld    c,a
  659.     inc    hl
  660.     ld    a,b
  661.     sbc    (hl)
  662.     ld    b,a
  663.         
  664.     pop    hl        ; Recover HL
  665.     push    hl
  666.  
  667.     ld    a,l        ; Subtract high words
  668.     sbc    e        ; (Subtract DE from HL)
  669.     ld    l,a
  670.     ld    a,h
  671.     sbc    #0
  672.     ld    h,a
  673.     jr    nc,4$
  674.     pop    hl        ; DEfw1fw0 is greater than HLBC
  675.     pop    bc        ; restore dividend
  676.     jr    5$
  677.  
  678. 4$:
  679.     lda    sp,4(sp)    ;unjunk stack
  680. 5$:
  681.     ccf            ; complement carry bit
  682.     push    hl
  683.     ld    hl,#.q
  684.     rl    (hl)
  685.     inc    hl
  686.     rl    d
  687.     inc    hl
  688.     rl    (hl)
  689.     inc    hl
  690.     rl    (hl)
  691.     pop    hl
  692.     
  693.     or    a        ; clear carry flag
  694.     rl    c        ; Shift HLBC left 
  695.     rl    b
  696.     rl    l    
  697.     rl    h
  698.     
  699.     ld    a,(.fdiv32loops)
  700.     dec    a        ;decrement loop count
  701.     ld    (.fdiv32loops),a
  702.     jr    nz,3$
  703.  
  704.     ld    hl,#.q
  705.     ld    a,(hl+)
  706.     ld    e,a
  707.     inc    hl        ; D is taken care of above
  708.     ld    l,(hl)
  709.     ld    a,(.q+3)
  710.  
  711.     ld    h,#0
  712.     ld    c,h        ;zero lower byte
  713.     jr    1$        ;skip forward
  714. 2$:
  715.     srl    a
  716.     rr    l
  717.     rr    d
  718.     rr    e
  719.     rr    c        ;save carry bit in c
  720.     inc    h
  721. 1$:
  722.     or    a        ;hi byte zero yet?
  723.     jr    nz,2$        ;no, keep shifting down
  724.  
  725.     push    af
  726.     ld    a,c        ;copy shifted-out bits
  727.     ld    (.scratch),a
  728.     pop    af
  729.  
  730.     pop    bc        ;restore exponents
  731.     push    bc        ;save signs
  732.     ld    a,c
  733.     res    7,a
  734.     res    7,b
  735.     sub    b
  736.     add    #0x041-6        ;compensate
  737.     add    a,h
  738.     ld    h,a
  739.     pop    bc
  740.     ld    a,c
  741.     xor    b        ; get sign
  742.     bit    7,a        ; Jump if a is positive
  743.     jr    z,6$
  744.  
  745.     set    7,h
  746. 6$:
  747.     ld    a,(.scratch)
  748.     rla
  749.     call    c,round        ; round if necessary
  750.     jp    fpnorm        ; normalize it and return
  751.  
  752. ; .add32 - add HLDE and stack
  753. ;  Add HLDE to the 4 byte long on the stack, returning the result in HLDE
  754. ;  Note that the stack grows downwards fro the top, so SP+0 is the return address,
  755. ;   SP+2 is the least significant byte and SP+5 is the most significant
  756. ;    So push hl; push de
  757. .add32::
  758.     LD    B,H        ; BC = temporary registers
  759.     LD    C,L
  760.     LDA    HL,2(SP)    ; HL = LSB of operand
  761.     LD    A,E
  762.     ADD    (HL)
  763.     LD    E,A
  764.     INC    HL
  765.     LD    A,D
  766.     ADC    (HL)
  767.     LD    D,A
  768.     INC    HL
  769.     LD    A,C
  770.     ADC    (HL)
  771.     LD    C,A
  772.     INC    HL
  773.     LD    A,B
  774.     ADC    (HL)
  775.     LD    H,A
  776.     LD    L,C
  777.     POP    BC        ; Return address
  778.     LDA    SP,4(SP)    ; Remove the operand from the stack
  779.     PUSH    BC        ; Put return address back on stack
  780.     RET
  781.  
  782. ; .sub32 - subtract stack from HLDE
  783. ;  Subtract the 4 byte long on the stack at SP+2 from HLDE
  784. .sub32::
  785.     LD    B,H
  786.     LD    C,L
  787.     LDA    HL,2(SP)    ; HL points to the operand
  788.     LD    A,E
  789.     SUB    (HL)
  790.     LD    E,A
  791.     INC    HL
  792.     LD    A,D
  793.     SBC    (HL)
  794.     LD    D,A
  795.     INC    HL
  796.     LD    A,C
  797.     SBC    (HL)
  798.     LD    C,A
  799.     INC    HL
  800.     LD    A,B
  801.     SBC    (HL)
  802.     LD    H,A
  803.     LD    L,C
  804.     POP    BC        ; Return address
  805.     LDA    SP,4(SP)    ; Remove the operand from the stack
  806.     PUSH    BC        ; Put return address back on stack
  807.     RET
  808.  
  809. ; .neg32 - negate HLDE
  810. ;  Note that HLDE is a in two's complement form
  811. ;  The order of the complementing the registers is unimportant
  812. .neg32::
  813.     LD    A,E
  814.     CPL            ; Take 2's complement of A
  815.     LD    E,A
  816.     LD    A,D
  817.     CPL
  818.     LD    D,A
  819.     LD    A,L
  820.     CPL
  821.     LD    L,A
  822.     LD    A,H
  823.     CPL
  824.     LD    H,A
  825.     RET
  826.  
  827. ; .cpl32 - complement HLDE
  828. ;  Confused - dosnt this do the same as .neg32?
  829. .cpl32::
  830.     XOR    A        ; Zero A, clear flags
  831.     SUB    E
  832.     LD    E,A
  833.     LD    A,#0x00
  834.     SBC    D
  835.     LD    D,A
  836.     LD    A,#0x00
  837.     SBC    L
  838.     LD    L,A
  839.     LD    A,#0x00
  840.     SBC    H
  841.     LD    H,A
  842.     RET
  843.  
  844. ; .xor32 - logical XOR of HLDE with the stack
  845. .xor32::
  846.     LD    B,H        ; Temporarialy store HL in BC
  847.     LD    C,L
  848.     LDA    HL,2(SP)    ; HL points to the operand
  849.     LD    A,E
  850.     XOR    (HL)
  851.     LD    E,A
  852.     INC    HL
  853.     LD    A,D
  854.     XOR    (HL)
  855.     LD    D,A
  856.     INC    HL
  857.     LD    A,C
  858.     XOR    (HL)
  859.     LD    C,A
  860.     INC    HL
  861.     LD    A,B
  862.     XOR    (HL)
  863.     LD    H,A
  864.     LD    L,C
  865.     POP    BC        ; Return address
  866.     LDA    SP,4(SP)    ; Remove the operand
  867.     PUSH    BC        ; Put return address back on stack
  868.     RET
  869.  
  870. ; .or32 - logical OR of HLDE with the stack
  871. .or32::
  872.     LD    B,H
  873.     LD    C,L
  874.     LDA    HL,2(SP)
  875.     LD    A,E
  876.     OR    (HL)
  877.     LD    E,A
  878.     INC    HL
  879.     LD    A,D
  880.     OR    (HL)
  881.     LD    D,A
  882.     INC    HL
  883.     LD    A,C
  884.     OR    (HL)
  885.     LD    C,A
  886.     INC    HL
  887.     LD    A,B
  888.     OR    (HL)
  889.     LD    H,A
  890.     LD    L,C
  891.     POP    BC        ; Return address
  892.     LDA    SP,4(SP)
  893.     PUSH    BC        ; Put return address back on stack
  894.     RET
  895.  
  896. ; .and32 - logical AND of HLDE with the stack
  897. .and32::
  898.     LD    B,H
  899.     LD    C,L
  900.     LDA    HL,2(SP)
  901.     LD    A,E
  902.     AND    (HL)
  903.     LD    E,A
  904.     INC    HL
  905.     LD    A,D
  906.     AND    (HL)
  907.     LD    D,A
  908.     INC    HL
  909.     LD    A,C
  910.     AND    (HL)
  911.     LD    C,A
  912.     INC    HL
  913.     LD    A,B
  914.     AND    (HL)
  915.     LD    H,A
  916.     LD    L,C
  917.     POP    BC        ; Return address
  918.     LDA    SP,4(SP)
  919.     PUSH    BC        ; Put return address back on stack
  920.     RET
  921.  
  922. ; .asl32 - arithmitic shift left of HLDE 'A' times
  923. .asl32::
  924. 1$:
  925.     SLA    E
  926.     RL    D
  927.     RL    L
  928.     RL    H
  929.     DEC    A
  930.     JR    NZ,1$
  931.     RET
  932.  
  933. ; .asr32 - arithmitic shift right of HLDE 'A' times
  934. .asr32::
  935. 1$:
  936.     SRA    H
  937.     RR    L
  938.     RR    D
  939.     RR    E
  940.     DEC    A
  941.     JR    NZ,1$
  942.     RET
  943.  
  944. ; .lsl32 - logical shift left of HLDE 'A' times
  945. .lsl32::
  946. 1$:
  947. ;    SLL    E
  948.     RL    D
  949.     RL    L
  950.     RL    H
  951.     DEC    A
  952.     JR    NZ,1$
  953.     RET
  954.  
  955. ; .lsr32 - logical shift right of HLDE 'A' times
  956. .lsr32::
  957. 1$:
  958.     SRL    H
  959.     RR    L
  960.     RR    D
  961.     RR    E
  962.     DEC    A
  963.     JR    NZ,1$
  964.     RET
  965.  
  966. ; .cmp32 - check if HLDE is negative, positive or zero
  967. ;  Can be used with a subtraction to compare numbers
  968. ;   If ( A-B > 0 ) A > B
  969. ;   If ( A-B = 0 ) B = A
  970. ;   If ( A-B < 0 ) A < B
  971. ;  Returns Z = 1 if HLDE = 0, C = 1 if HLDE < 0
  972.  
  973.     ;; Long comparison Sets C if HLDE is negative, and Z if HLDE is zero.
  974. .cmp32::
  975.     BIT    7,H        ; Test sign
  976.     JR    Z,1$
  977.     LD    A,E        ; Set Z flag
  978.     OR    D        ; xxx confused
  979.     OR    L
  980.     OR    H
  981.     SCF            ; Negative:    set carry flag
  982.     RET
  983. 1$:
  984.     LD    A,E        ; Set Z flag
  985.     OR    D
  986.     OR    L
  987.     OR    H
  988.     SCF            ; Positive:    clear carry flag
  989.     CCF
  990.     RET
  991.  
  992.     ;; Long multiplication for Z80.
  993.     ;;
  994.     ;; Called with 1st arg in HLDE, 2nd arg on stack. Returns with
  995.     ;;  result in HLDE, other argument removed from stack.
  996.  
  997. ;    Long multiplication for Z80
  998.  
  999. ;    Called with 1st arg in HLDE, 2nd arg on stack. Returns with
  1000. ;    result in HLDE, other argument removed from stack
  1001.  
  1002. ;    global    almul, llmul
  1003.  
  1004. ;    psect    text
  1005. ;almul:
  1006. ;llmul:
  1007. ;
  1008.  
  1009. ; Tests:
  1010. ;    Square 27A3, giving 62311C9
  1011. ;    Initial: 6796
  1012. ;    Change final exx for simple moves - 6360
  1013. ;    Change middle exx to simple moves - 6040
  1014. ;    Changed to mul DEBC, adding to HLHL' - 5672
  1015. ;    Cleaned up afterwards    - 5460
  1016. ;    Tried changing push af to ld (.scratch),a in mul8 - 5540
  1017. ;    Changed so that mul by 256 (0) is simple swap - 3476
  1018. ;       Fixed 32 cycle offset in timer - 3444
  1019.  
  1020. .mul32::            ; hl=1,de=2,sp+4=3,sp+2=4
  1021.     ; None of this mucking about...
  1022.     ; HLDE to mul3 mul2 mul1 mul0
  1023.     ; Begin profiling
  1024.     ld a,h
  1025.     ld (.mul+3),a        ; mulB
  1026.     ld a,l
  1027.     ld (.mul+2),a        ; mulC
  1028.     ld a,d
  1029.     ld (.mul+1),a        ; .Bp
  1030.     ld a,e
  1031.     ld (.mul+0),a        ; - 80 cycles .Cp
  1032.     
  1033.     pop hl            ; HL is ret address
  1034.     pop de
  1035.     pop bc
  1036.     push hl            ; Put ret address back
  1037.                 ; - 132 cycles
  1038.  
  1039.     xor a            ; Zero HLHL'
  1040.     ld h,a            ; (the result)
  1041.     ld l,a
  1042.     ld (.res+1),a
  1043.     ld (.res+0),a        ; - 176 cycles
  1044.     
  1045.     
  1046.     ld a,(.mul+0)        ; Do the actual multiply
  1047.     call .mul8b        ; - 1704 cycles
  1048.  
  1049.     ld a,(.mul+1)
  1050.     call .mul8b        ; - 3232 cycles
  1051.  
  1052.     ld a,(.mul+2)
  1053.     call .mul8b        ; - 3304 cycles
  1054.  
  1055.     ld a,(.mul+3)
  1056.     call .mul8b        ; - 3376 cycles
  1057.  
  1058.     ld d,h
  1059.     ld e,l
  1060.     ld a,(.res+1)
  1061.     ld h,a
  1062.     ld a,(.res+0)
  1063.     ld l,a            ; - 3424 cycles
  1064.  
  1065.     ret
  1066.  
  1067. .mul8b:
  1068.     cp a,#0
  1069.     jr nz,.realmul8b
  1070.     ; Simple hack so that if we're multipling by zero then just
  1071.     ;  the shift is performed
  1072.     ld e,d
  1073.     ld d,c
  1074.     ld c,b
  1075.     ld b,#0
  1076.     ret
  1077.  
  1078. .realmul8b:
  1079.     push af
  1080.     ld a,#8
  1081.     ld (.mulloops),a
  1082. 1$:
  1083.     pop af
  1084.     SRL    A        ; Shift A left, LSB into carry
  1085.     JP    NC,2$        ; LSB of A was zero, so continue
  1086.     ADD    HL,DE        ; Add low words
  1087.     ; Originally 149 cycles, now 100
  1088.     PUSH    AF
  1089.     LD    A,(.res+0)    ; Add DE' to HL'
  1090.     ADC    c
  1091.     LD    (.res+0),A
  1092.     LD    A,(.res+1)
  1093.     ADC    b
  1094.     LD    (.res+1),A
  1095.                 ; Hee hee - these two were around the wrong way
  1096.     POP    AF
  1097.     ; To here
  1098. 2$:
  1099.     SLA    E        ; Rotate the multiplier left (DE)
  1100.     RL    D
  1101.     ; This section took 90 cycles, now 16
  1102.     rl    c
  1103.     rl    b
  1104.  
  1105.     push af
  1106.     ld a,(.mulloops)
  1107.     DEC    a        ; Loop until all 8 bits are done
  1108.     ld (.mulloops),a
  1109.     JR    NZ,1$
  1110.     pop af    
  1111.     RET
  1112. ; Long division routines for Z80.
  1113. ;
  1114. ; Called with dividend in HLDE, divisor on stack under 2 return
  1115. ;  addresses. Returns with dividend in HL/HL', divisor in DE/DE'
  1116. ;  on return the HIGH words are selected.
  1117. ; Interface between C type HLDE/stack operands and that required for divide
  1118. ; In divide,
  1119. ;    dividend is HLHL'
  1120. ;    divisor  is DEBC
  1121. ;    divisor  is removed from stack
  1122. ;    
  1123. ;    Notes:
  1124. ;    +0    HL
  1125. ;    +2    ret outer
  1126. ;    +4    ret inner
  1127. ;    +6    div.l
  1128. ;    +8    div.h
  1129.  
  1130. .mod32::
  1131.     call    .lregset
  1132.     call    divide
  1133.     ld    a,(.div+0)
  1134.     ld    e,a
  1135.     ld    a,(.div+1)
  1136.     ld    d,a
  1137.     ret
  1138.     
  1139. .div32::
  1140.     call    .lregset
  1141.     call    divide
  1142.     ld    a,(.q+3)    
  1143.     ld    h,a
  1144.     ld    a,(.q+2)    
  1145.     ld    l,a
  1146.     ld    a,(.q+1)    
  1147.     ld    d,a
  1148.     ld    a,(.q+0)    
  1149.     ld    e,a
  1150.     ret
  1151.  
  1152. .lregset:
  1153.                 ; SP = +2
  1154.     ld    a,e        ; Low word of dividend into HL'
  1155.     ld    (.div+0),a
  1156.     ld    a,d
  1157.     ld    (.div+1),a    ; DE is now free
  1158.     push    hl        ; HL is free
  1159.                 ; SP = 0
  1160.     lda    sp,2(sp)    ; (+2)
  1161.     pop    de        ; First return address
  1162.                 ; SP = +4
  1163.     pop    hl        ; Second return address
  1164.                 ; SP = +6
  1165.                 ; Points to divisor.L
  1166.     pop    bc        ; Get divisor.L
  1167.                 ; SP = +8
  1168.     push    de        ; Restore return address
  1169.                 ; SP = +6
  1170.     lda    sp,2(sp)    ; Points to divisor.H
  1171.                 ; SP = +8
  1172.     pop    de
  1173.                 ; SP = +10
  1174.     push    hl        ; Restore inner return address
  1175.                 ; SP = +8
  1176.     lda    sp,-8(sp)    ; Recover HL
  1177.                 ; SP = 0
  1178.     pop    hl
  1179.     lda    sp,4(sp)
  1180.     ret
  1181.  
  1182. ; .lregset:
  1183. ;     POP    BC        ; Get top return address
  1184. ;     CALL    .exx        ; Select other bank
  1185. ;     POP    BC        ; Return address of call to this module
  1186. ;     POP    DE        ; Get low word of divisor
  1187. ;     CALL    .exx        ; Select hi bank
  1188. ;     EX    DE,HL        ; Dividend.low -> HL
  1189. ;     EX    (SP),HL        ; Divisor.high -> HL
  1190. ;     EX    DE,HL        ; Dividend.high -> HL
  1191. ;     CALL    .exx        ; Back to low bank
  1192. ;     PUSH    BC        ; Put outer r.a. back on stack
  1193. ;     POP    HL        ; Return address
  1194. ;     EX    (SP),HL        ; Dividend.low -> HL
  1195. ;     CALL    .exx
  1196. ;     PUSH    BC        ; Top return address
  1197. ;     RET
  1198.  
  1199. ; ;    Much the same as lregset, except that on entry the dividend
  1200. ; ;    is pointed to by HL.
  1201. ; ;    The pointer is saved in iy for subsequent updating of memory
  1202.  
  1203. ; iregset:
  1204. ;     pop    de        ;immediate return address
  1205. ;     call    lregset        ;returns with hi words selected
  1206. ;     push    hl        ;save a copy for 'ron
  1207. ;     ex    (sp),iy        ;get it in iy, saving old iy
  1208. ;     ld    h,(iy+3)    ;high order byte
  1209. ;     ld    l,(iy+2)    ;byte 2
  1210. ;     exx            ;back to low bank
  1211. ;     push    hl        ;return address
  1212. ;     ld    h,(iy+1)    ;byte 1
  1213. ;     ld    l,(iy+0)    ;and LSB
  1214. ;     exx            ;restore hi words
  1215. ;     ret            ;now return
  1216.  
  1217. ; ;    Called with hi words selected, performs division on the absolute
  1218. ; ;    values of the dividend and divisor. Quotient is positive
  1219.  
  1220. ; sgndiv:
  1221. ;     call    negif        ;make dividend positive
  1222. ;     exx
  1223. ;     ex    de,hl        ;put divisor in HL/HL'
  1224. ;     exx
  1225. ;     ex    de,hl
  1226. ;     call    negif        ;make divisor positive
  1227. ;     ex    de,hl        ;restore divisor to DE/DE'
  1228. ;     exx
  1229. ;     ex    de,hl
  1230. ;     exx            ;select high words again
  1231. ;     jp    divide        ;do division
  1232.  
  1233. ; asaldiv:
  1234. ;     call    iregset
  1235. ;     call    dosdiv
  1236. ; store:
  1237. ;     ld    (iy+0),e
  1238. ;     ld    (iy+1),d
  1239. ;     ld    (iy+2),l
  1240. ;     ld    (iy+3),h
  1241. ;     pop    iy        ;restore old iy
  1242. ;     ret
  1243.  
  1244. ; aldiv:
  1245. ;    call    lregset        ;get args
  1246.  
  1247. ; ;    Called with high words selected, performs signed division by
  1248. ; ;    the rule that the quotient is negative iff the signs of the dividend
  1249. ; ;    and divisor differ
  1250. ; ;    returns quotient in HL/DE
  1251.  
  1252. ; dosdiv:
  1253. ;     ld    a,h
  1254. ;     xor    d
  1255. ;     ex    af,af'        ;sign bit is now sign of quotient
  1256. ;     call    sgndiv        ;do signed division
  1257. ;     ex    af,af'        ;get sign flag back
  1258. ;     push    bc        ;high word
  1259. ;     exx
  1260. ;     pop    hl
  1261. ;     ld    e,c        ;low word of quotient
  1262. ;     ld    d,b
  1263. ;     jp    m,negat        ;negate quotient if necessary
  1264. ;     ret
  1265.  
  1266. ; lldiv:    call    lregset
  1267.  
  1268. ; ;    Called with high words selected, performs unsigned division
  1269. ; ;    returns with quotient in HL/DE
  1270.  
  1271. ; doudiv:
  1272. ;     call    divide        ;unsigned division
  1273. ;     push    bc        ;high word of quotien
  1274. ;     exx
  1275. ;     pop    hl
  1276. ;     ld    e,c        ;low word
  1277. ;     ld    d,b
  1278. ;     ret
  1279.  
  1280. ; aslldiv:
  1281. ;     call    iregset
  1282. ;     call    doudiv
  1283. ;     jp    store
  1284.  
  1285.  
  1286. ; almod:
  1287. ;     call    lregset
  1288.  
  1289. ; ;    Called with high words selected, performs signed modulus - the rule
  1290. ; ;    is that the sign of the remainder is the sign of the dividend
  1291.  
  1292. ; dosrem:
  1293. ;     ld    a,h        ;get sign of dividend
  1294. ;     ex    af,af'        ;save it
  1295. ;     call    sgndiv        ;do signed division
  1296. ;     push    hl        ;high word
  1297. ;     exx
  1298. ;     pop    de
  1299. ;     ex    de,hl        ;put high word in hl
  1300. ;     ex    af,af'        ;get sign bit back
  1301. ;     or    a
  1302. ;     jp    m,negat        ;negate if necessary
  1303. ;     ret
  1304.  
  1305. ; asalmod:
  1306. ;     call    iregset
  1307. ;     call    dosrem
  1308. ;     jp    store
  1309.  
  1310. ; llmod:
  1311. ;     call    lregset
  1312.  
  1313. ; ;    Called with high words selected, perform unsigned modulus
  1314.  
  1315. ; dourem:
  1316. ;     call    divide
  1317. ;     push    hl        ;high word of remainder
  1318. ;     exx
  1319. ;     pop    de
  1320. ;     ex    de,hl        ;high word in hl
  1321. ;     ret
  1322.  
  1323. ; asllmod:
  1324. ;     call    iregset
  1325. ;     call    dourem
  1326. ;     jp    store
  1327.  
  1328. ; ;    Negate the long in HL/DE
  1329.  
  1330. ; negat:    push    hl    ;save high word
  1331. ;     ld    hl,0
  1332. ;     or    a
  1333. ;     sbc    hl,de
  1334. ;     ex    de,hl
  1335. ;     pop    bc        ;get high word back
  1336. ;     ld    hl,0
  1337. ;     sbc    hl,bc
  1338. ;     ret        ;finito
  1339.  
  1340. ; negif:    ;called with high word in HL, low word in HL'
  1341. ;     ;returns with positive value
  1342.  
  1343. ;     bit    7,h        ;check sign
  1344. ;     ret    z        ;already positive
  1345. ;     exx            ;select low word
  1346. ;     ld    c,l
  1347. ;     ld    b,h
  1348. ;     ld    hl,0
  1349. ;     or    a
  1350. ;     sbc    hl,bc
  1351. ;     exx
  1352. ;     ld    c,l
  1353. ;     ld    b,h
  1354. ;     ld    hl,0
  1355. ;     sbc    hl,bc
  1356. ;     ret            ;finito
  1357.  
  1358. ;    Called with dividend in HLHL', divisor in DEBC, high words in
  1359. ;    selected register set
  1360. ;    returns with quotient in q3q2q1q0 and DEBC, remainder in HLHL',
  1361. ;    high words selected
  1362.  
  1363.  
  1364. ;    Tests on div 62311C9 by 27A3 = 27A3 
  1365. ;    Initial conversion    - 102096
  1366. ;    Replaced exx and shift at end    -  90688
  1367. ;    Shifted loop counter from AF to -  87216
  1368. ;     mem, freeing AF
  1369. ;    Removed need for exx's aroung $1-  81068
  1370. ;    Changed shift right DEDE' to    -  62708
  1371. ;     something simpler
  1372. ;    Much cleaning and removing of    -  20904
  1373. ;     exx's
  1374.  
  1375. ; From the analysis, S is the most used register.  I'll make S DEBC and
  1376. ;  Q .q0,.q1,.q2,.q3
  1377. ;    New time        -  16024
  1378. ;    Further triming and the quick    -   8548
  1379. ;     rotate optimization
  1380.  
  1381. ;    Algorithim
  1382. ;    Given dividend A and divisor S, return quotient Q and
  1383. ;    remainder R such that
  1384. ;    A    = ( S * Q ) + R
  1385. ;    HLHL'    is A
  1386. ;    DEDE'    is S
  1387. ;    Returns    Q in BCBC'
  1388. ;        R in HLHL'
  1389. ;
  1390. ;    Simplified
  1391. ;    Init
  1392. ;    Set    Q=0
  1393. ;    Set    loops=1
  1394. ;    Make S bigger than A by rotating
  1395. ;    If S > A, continue
  1396. ;    Rotate S right
  1397. ;    Increase loops
  1398. ;    If MSB(S)==1, continue
  1399. ;     else loop
  1400. ;    One step of the divide
  1401. ;    If S > A, then LSB(Q)=0
  1402. ;     else
  1403. ;        LSB(Q)=1
  1404. ;        Subtract S from A
  1405. ;    Rotate Q left
  1406. ;    Rotate S right
  1407. ;    Decrease loop counter
  1408. ;    Loop while loop counter>0
  1409. ;----------------------------------------------------
  1410. ;    Every time
  1411. ;    Parts:
  1412. ;        divide - 
  1413. ;        Init Q (BCBC')=0
  1414. ;        Return if S (DEDE')=0
  1415. ;        Set loops left to 1
  1416. ;        1$ -
  1417. ;        Check to see if S is greater than A
  1418. ;        If yes,
  1419. ;            Goto 2 with C set
  1420. ;        If no,
  1421. ;            Rotate S (DEDE') right
  1422. ;            Increase the number of loops left
  1423. ;            If MSB S !=1, goto 1$ (at 3$)
  1424. ;        2$ -
  1425. ;        6$ -
  1426. ;        Subtract S from A
  1427. ;        If S is less than A, then goto 5$ (C=0)    
  1428. ;        Else, restore value of A (C=1), goto 5$
  1429. ;        5$ -
  1430. ;        Complement the carry flag
  1431. ;        Rotate BCBC' left, shifting in C
  1432. ;        Rotate DEDE' right
  1433. ;        Decrease loop count
  1434. ;        Loop to 6$ while loop count > 0
  1435. ;        
  1436.  
  1437. divide:
  1438. ;    rst    0x08
  1439. ;    .asciz "divide "
  1440.     xor    a        ; Set quotient to zero
  1441.     ld    (.q+0),a
  1442.     ld     (.q+1),a
  1443.     ld    (.q+2),a
  1444.     ld     (.q+3),a
  1445.      ld    a,e        ;check for zero divisor
  1446.      or    d
  1447.     or    c
  1448.     or    b
  1449.      ret    z        ;return with quotient == 0
  1450.      ld    a,#1        ;loop count
  1451.     ld     (.ldivloopcount),a
  1452.  
  1453.     ; Simple optmisation
  1454.     ; If H <> 0 and E == 0, then DEBC is at least 8 bits smaller than
  1455.     ;  HLHL', so do a simple swap instead of rotate
  1456.     xor    a        ; Is H<>0 ?
  1457.     cp    h
  1458.     jp    z,3$        ; Cant hack
  1459.     ld    a,d
  1460.     or    e    
  1461.     jp    nz,3$        ; Cant hack
  1462.  
  1463.     ld    d,e        ; DE=0 and H!=0
  1464.     ld    e,b        ; 'Rotate' DEBC 8 to the right
  1465.     ld     b,c
  1466.     ld    c,a        ; A is zero
  1467.     ld    a,#9        ; Increase loop counter by 8
  1468.     ld    (.ldivloopcount),a
  1469.  
  1470.      jp    3$        ;enter loop in middle
  1471. 1$:
  1472.      or    a        ; clear carry
  1473.     ld     a,(.div+0)    ; Subtract DEBC from HLHL'
  1474.     sub     c        ; to compare them
  1475.     ld     a,(.div+1)    ; C=1 - DEBC > HLHL'
  1476.     sbc     b
  1477.     ld     a,l
  1478.     sbc     e
  1479.     ld     a,h
  1480.     sbc     d
  1481.  
  1482.      jr    c,2$        ;finished - divisor is big enough
  1483.     ld    a,(.ldivloopcount)
  1484.      inc    a        ;increment count
  1485.     ld    (.ldivloopcount),a
  1486.  
  1487.     or    a        ;Shift DEBC left
  1488.     rl    c
  1489.     rl    b
  1490.     rl    e
  1491.     rl    d
  1492. 3$:
  1493.      bit    7,d        ;test for max divisor
  1494.      jp    z,1$        ;loop if msb not set
  1495. 2$:    ; arrive here with shifted divisor, loop count in a, and low words
  1496.      ;selected
  1497.     
  1498. 6$:
  1499.      push    hl        ;save dividend
  1500.     ld    a,(.div+0)
  1501.     push    af
  1502.     ld    a,(.div+1)
  1503.     push     af
  1504.  
  1505.     or    a        ;clear carry
  1506.     ld     a,(.div+0)    ; Subtract DEBC from HLHL'
  1507.     sbc     c
  1508.     ld    (.div+0),a
  1509.     ld     a,(.div+1)
  1510.     sbc     b
  1511.     ld    (.div+1),a
  1512.  
  1513.     ld    a,l
  1514.     sbc    e
  1515.     ld    l,a
  1516.     ld    a,h
  1517.     sbc    d
  1518.     ld    h,a
  1519.  
  1520.      jp    nc,4$        ; HLHL' is bigger than DEBC
  1521.     pop    af
  1522.     ld    (.div+1),a
  1523.     pop    af
  1524.     ld    (.div+0),a
  1525.      pop    hl        ;hi word
  1526.     scf            ; C junked by POP AF
  1527.      jr    5$
  1528. 4$:
  1529.     lda    sp,6(sp)    ;unjunk stack
  1530. 5$:
  1531.      ccf        ;complement carry bit
  1532.     ld    a,(.q+0)        ; Rotate quotient Q left
  1533.     rl    a        ; Rotate in C flag
  1534.     ld    (.q+0),a
  1535.     ld     a,(.q+1)
  1536.     rl     a
  1537.     ld    (.q+1),a
  1538.     ld    a,(.q+2)
  1539.     rl    a
  1540.     ld    (.q+2),a
  1541.     ld     a,(.q+3)
  1542.     rl     a
  1543.     ld    (.q+3),a
  1544.  
  1545.      srl    d        ; Shift divisor right
  1546.      rr    e
  1547.     rr    b
  1548.     rr    c
  1549.     
  1550.     ld    a,(.ldivloopcount)
  1551.      dec    a        ;decrement loop count
  1552.     ld    (.ldivloopcount),a
  1553.      jr    nz,6$
  1554.  
  1555. ;    Setup the expected return values
  1556. ;    ld    a,(.q3)
  1557. ;    ld    d,a
  1558. ;    ld    a,(.q2)
  1559. ;    ld    e,a
  1560. ;    ld    a,(.q1)
  1561. ;    ld    b,a
  1562. ;    ld    a,(.q0)
  1563. ;    ld    c,a
  1564.      ret            ;finished
  1565. ;    Conversion of integer type things to floating. Uses routines out
  1566. ;    of float.as.
  1567.  
  1568. ;    psect    text
  1569.  
  1570. ;    global    altof, lltof, aitof, litof, abtof, lbtof
  1571. ;    global    fpnorm
  1572.  
  1573. lbtof:
  1574.     ld    e,a
  1575.     ld    d,#0
  1576. litof:
  1577.     push    hl
  1578.     pop    de
  1579. ;    ex    de,hl        ;put arg in de
  1580.     ld    l,#0        ;zero top byte
  1581. b3tof:
  1582.     ld    h,#64+24
  1583.     jp    fpnorm
  1584.  
  1585. abtof:
  1586.     ld    e,a
  1587.     rla
  1588.     sbc    a,a
  1589.     ld    d,a
  1590.  
  1591. aitof:
  1592.     bit    7,h        ;negative?
  1593.     jp    z,litof        ;no, treat as unsigned
  1594.     ; Negate HL
  1595.     xor    a
  1596.     sub    l
  1597.     ld    l,a
  1598.     ld    a,#0
  1599.     sbc    h
  1600.     ld    h,a
  1601.     call    litof
  1602.     set    7,h        ;set sign flag
  1603.     ret
  1604.  
  1605. lltof:
  1606.     ld    a,h        ;anything in top byte?
  1607.     or    a
  1608.     jr    z,b3tof        ;no, just do 3 bytes
  1609.     ld    e,d        ;shift down 8 bits
  1610.     ld    d,l
  1611.     ld    l,h
  1612.     ld    h,#64+24+8    ;the 8 compensates for the shift
  1613.     jp    fpnorm        ;and normalize it
  1614.  
  1615. altof:
  1616.     bit    7,h        ; negative?
  1617.     jr    z,lltof        ; no, treat as unsigned
  1618.     xor    a        ; Negate HLDE
  1619.     sub    e
  1620.     ld    e,a
  1621.     ld    a,#0
  1622.     sbc    d
  1623.     ld    d,a
  1624.     ld    a,#0
  1625.     sbc    l
  1626.     ld    l,a
  1627.     ld    a,#0
  1628.     sbc    h
  1629.     ld    h,a
  1630.  
  1631.     call    lltof
  1632.     set    7,h        ;set sign flag
  1633.     ret
  1634.  
  1635. ;    ftol - convert floating to long, by using lower bits can also
  1636. ;    be used to convert from float to int or char
  1637.  
  1638. ;    psect    text
  1639. ;    global    ftol
  1640. ;    global    alrsh, allsh, negmant
  1641.  
  1642. ftol:
  1643.     bit    7,h        ;test sign
  1644.     call    nz,negmant    ;negate mantissa if required
  1645.     ld    a,h        ;get exponent
  1646.     res    7,a        ;mask sign off
  1647.     sub    #64+24        ;remove offset
  1648.     ld    b,a        ;save shift count
  1649.     ld    a,h        ;get exponent, sign
  1650.     rla
  1651.     sbc    a,a        ;sign extend
  1652.     ld    h,a        ;put back
  1653.     bit    7,b        ;test sign
  1654. ;    jp    z,allsh        ;shift it left
  1655.     ld    a,#0        ; Get the count
  1656.     sub    b
  1657. ;    neg            ;make +ve
  1658.     dec    a        ;and reduce it one
  1659.     ld    b,a        ;put back in b
  1660. ;    call    nz,alrsh    ;shift right
  1661.     ; add one for rounding
  1662.     ld    a,#1
  1663.     add    e
  1664.     ld    e,a
  1665.     ld    a,#0
  1666.     add    d
  1667.     ld    d,a
  1668. ;    jp    nc,alrsh    ;and shift down one more
  1669.     inc    hl        ;add in carry first
  1670. ;    jp    alrsh
  1671. ; LWORD _fbcd(float x, WORD *exp, char *buf)
  1672. ;
  1673. ; Split x into mantissa and decimal exponent parts.
  1674. ; Return value is the (long) mantissa part, exponent part is
  1675. ;  stored in *exp as two's complement. Mantissa is stored into buf
  1676. ;  as an ascii string.
  1677.  
  1678.     .NDIG        = 8    ; Number of decimal digits
  1679.  
  1680.     .globl    .lldiv,.llmod
  1681.  
  1682. .hasfrac:
  1683.     LD    C,#0x00        ; Zero number
  1684.     LD    A,E        ; Check low 8 bits
  1685.     OR    A
  1686.     JR    NZ,1$        ; Non zero bit in low 8 bits
  1687.     LD    C,#8        ; Bump count
  1688.     LD    A,D        ; Check next 8 bits
  1689.     OR    A        ; Is there a bit there?
  1690.     JR    NZ,1$        ; Yup
  1691.     LD    C,#16
  1692.     LD    A,H        ; Now check next 8 bits
  1693. 1$:
  1694.     RRA            ; Shift bottom bit out
  1695.     JR    C,2$        ; Found a bit!
  1696.     INC    C        ; Increment count
  1697.     JR    1$        ; And loop
  1698.  
  1699. 2$:
  1700.     LD    A,H        ; Get exponent
  1701.     RES    7,A        ; Clear sign bit - should be zero anyway
  1702.     SUB    #64+24        ; Normalize - remove bias
  1703.     ADD    A,C        ; Add in bit position
  1704.     RET            ; Return with value in a and flags set
  1705.  
  1706.     .area    _BSS
  1707.  
  1708. .fexp:
  1709.     .ds    0x01        ; Floating exponent temporary
  1710. .fsgn:
  1711.     .ds    0x01        ; Floating sign temporary
  1712.  
  1713.     .area    _DATA
  1714.  
  1715. .ftenth:
  1716.         ;; 0.1
  1717.     .db    0xcc
  1718.     .db    0xcc
  1719.     .db    0xcc
  1720.     .db    0x3d
  1721. .ften:
  1722.     ;; 10.0
  1723.     .db    0x0
  1724.     .db    0x0
  1725.     .db    0xa0
  1726.     .db    0x44
  1727.  
  1728.     .area    _CODE
  1729.  
  1730. __fbcd::
  1731.     PUSH    BC
  1732.  
  1733.     LDA    HL,9(SP)    ; Skip return address and registers
  1734.     LD    B,(HL)        ; BC = exp
  1735.     DEC    HL
  1736.     LD    C,(HL)
  1737.     LDA    HL,4(SP)
  1738.     LD    E,(HL)        ; HLDE = x
  1739.     INC    HL
  1740.     LD    D,(HL)
  1741.     INC    HL
  1742.     LD    A,(HL+)
  1743.     LD    L,(HL)
  1744.     LD    H,A
  1745.     XOR    A
  1746.     LD    (.fexp),A    ; Zero it
  1747.     LD    (.fsgn),A
  1748.     LD    (BC),A        ; And the returned exp value
  1749.     LD    A,H        ; Check for zero exponent
  1750.     AND    #0x7F        ; Zero exponent means 0.0
  1751.     JP    NZ,1$        ; Return if x == 0.0
  1752.     LD    L,A        ; Zero mantissa just in case
  1753.     LD    E,A
  1754.     LD    D,A
  1755.     LD    H,A        ; And sign/exponent
  1756.     JP    .sbcd        ; Return with mantissa = 0, exponent = 0
  1757. 1$:
  1758.     RES    7,H        ; Test mantissa sign
  1759. 2$:
  1760.     CALL    .hasfrac    ; Any fractional part?
  1761.     BIT    7,A
  1762.     JP    NZ,3$        ; Negative if there is fractional part
  1763.     PUSH    HL        ; Put x on stack
  1764.     PUSH    DE
  1765.     LD    A,(.ftenth+3)
  1766.     LD    H,A
  1767.     LD    A,(.ftenth+2)
  1768.     LD    L,A
  1769.     LD    A,(.ftenth+1)
  1770.     LD    D,A
  1771.     LD    A,(.ftenth)
  1772.     LD    E,A
  1773.     CALL    .fmul32        ; Returns with value in HLDE
  1774.     LD    A,(.fexp)
  1775.     INC    A        ; Increment exponent
  1776.     LD    (.fexp),A
  1777.     JR    2$        ; Now check again
  1778. 3$:
  1779.     PUSH    HL
  1780.     PUSH    DE        ; Pass x as argument
  1781.     LD    A,(.ften+3)
  1782.     LD    H,A
  1783.     LD    A,(.ften+2)
  1784.     LD    L,A
  1785.     LD    A,(.ften+1)
  1786.     LD    D,A
  1787.     LD    A,(.ften)
  1788.     LD    E,A
  1789.     CALL    .fmul32        ; Multiply it
  1790.     LD    A,(.fexp)
  1791.     DEC    A        ; And decrement exponent
  1792.     LD    (.fexp),A
  1793.     CALL    .hasfrac    ; Check for fractional part
  1794.     BIT    7,A
  1795.     JP    NZ,3$        ; Loop if still fractional
  1796.     LD    A,H        ; Get exponent
  1797.     LD    H,#0x00        ; Zero top byte
  1798.     SUB    #64+24        ; Offset exponent
  1799. 4$:
  1800.     OR    A        ; Check for zero
  1801.     JR    Z,6$        ; Return if finished
  1802.     BIT    7,A
  1803.     JP    Z,5$
  1804.     SRL    L        ; Shift L down
  1805.     RR    D        ; Rotate the rest
  1806.     RR    E
  1807.     INC    A        ; Increment count
  1808.     JR    4$
  1809. 5$:
  1810.     SLA    E
  1811.     RL    D
  1812.     RL    L
  1813.     RL    H
  1814.     DEC    A
  1815.     JR    4$
  1816. 6$:
  1817.     LD    A,(.fexp)
  1818.     PUSH    HL
  1819.     LD    B,(HL)        ; BC = exp
  1820.     DEC    HL
  1821.     LD    C,(HL)
  1822.     POP    HL
  1823.     LD    (BC),A        ; Store exponent
  1824.     INC    BC
  1825.     RLA
  1826.     SBC    A
  1827.     LD    (BC),A        ; Sign extend it
  1828.     LD    A,(.fsgn)
  1829.     BIT    0,A        ; Test sign
  1830.     JP    Z,.sbcd        ; Return if no negation needed
  1831.     XOR    A        ; Negate low word
  1832.     SUB    E
  1833.     LD    E,A
  1834.     LD    A,#0x00
  1835.     SBC    D
  1836.     LD    D,A
  1837.     LD    A,#0x00        ; Negate the hi word
  1838.     SBC    L
  1839.     LD    L,A
  1840.     LD    A,#0x00
  1841.     SBC    H
  1842.     LD    H,A
  1843.  
  1844. .sbcd:                ; Now store as ascii
  1845.     PUSH    HL
  1846.     PUSH    DE        ; Save return value
  1847.     PUSH    HL
  1848.     LDA    HL,11(SP)
  1849.     LD    B,(HL)        ; BC = buf
  1850.     DEC    HL
  1851.     LD    C,(HL)
  1852.     LD    HL,#.NDIG
  1853.     ADD    HL,BC        ; Point to end of buffer
  1854.     LD    (HL),#0x00    ; Null terminate
  1855.     LD    B,H        ; BC = pointer
  1856.     LD    C,L
  1857.     POP    HL
  1858.     LD    A,#.NDIG
  1859. 1$:
  1860.     PUSH    AF        ; Save count
  1861.     PUSH    BC        ; Save pointer
  1862.     PUSH    HL        ; Save value
  1863.     PUSH    DE
  1864.     LD    BC,#0x0000
  1865.     PUSH    BC        ; Pass 10 on stack
  1866.     LD    BC,#0x000A
  1867.     PUSH    BC
  1868.     CALL    .llmod
  1869.     LD    A,E        ; Get remainder
  1870.     ADD    A,#'0        ; Asciize
  1871.     POP    DE
  1872.     POP    HL        ; Restore value
  1873.     POP    BC        ; Restore pointer
  1874.     DEC    BC
  1875.     LD    (BC),A
  1876.     PUSH    BC        ; Save pointer
  1877.     LD    BC,#0x0000    ; Now divide by 10
  1878.     PUSH    BC
  1879.     LD    BC,#0x000A
  1880.     PUSH    BC
  1881.     CALL    .lldiv
  1882.     POP    BC        ; Restore pointer
  1883.     POP    AF        ; Restore count
  1884.     DEC    A
  1885.     JR    NZ,1$        ; Loop if more to do
  1886.     POP    DE        ; Restore return value
  1887.     POP    HL
  1888.  
  1889.     POP    BC
  1890.     RET            ; All done
  1891.